home *** CD-ROM | disk | FTP | other *** search
' ****************************************************** ' //THIS MODULE (REGMAX.BAS) IS DESIGNED TO BE INCLUDED IN YOUR ' //OWN PROJECT, AND CONTAINS ALL THE GBLIB2 FUNCTIONS ' //NECESSARY TO WRITE AND READ REGISTRATION DATA. ' //IT MUST BE USED IN CONJUNCTION WITH GBLIB2.EXE. ' //REGMAX.EXE, REGMAX.BAS (c)1995 Gordon Bamber// ' ****************************************************** Option Explicit ' /* Modified 11/01/95 [GB] */ ' /* Modified 06/01/95 [GB] */ ' /* Modified 02/01/95 [GB] */ ' /* Modified 31/12/94 [GB] */ ' /* Created 31/12/94 [GB] */ ' //WIN31 API Function to bar accidents in development mode!// ' //Alised so as not to clash with other declares in this project// Declare Function FindIt Lib "User" Alias "FindWindow" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer ' //*************** Declares for the API in GBLIB2.EXE *************// ' //This function is a crude string -> number algorithm// ' //It can be used to make a checksum of the registration information// Declare Function MakeAKey Lib "GBLIB2.EXE" (ByVal AString As String) As Long Declare Sub Encryptit Lib "GBLIB2.EXE" (ByVal AString As String, AStringLen As Integer) ' //The next three functions must NOT be used in development mode// ' //on this project, because they are designed to// ' //modify this application's EXE file directly, and until it has been// ' //compiled, there is no EXE file to modify! Declare Function WriteRegData Lib "GBLIB2.EXE" (ByVal sz_Name As String, ByVal sz_Org As String, ByVal sz_EXEPath As String, ByVal MyPhrase As String) As Integer Declare Function ReadRegData Lib "GBLIB2.EXE" (ByVal sz_EXEPath As String, ByVal sz_Name As String, ByVal sz_Org As String, ByVal YMD As String, NameLen As Integer, OrgLen As Integer) As Integer Declare Function CheckRegistration Lib "GBLIB2.EXE" (ByVal sz_EXEPath As String) As Integer Declare Function WriteRegDataToINI Lib "GBLIB2.EXE" (ByVal sz_Name As String, ByVal sz_Org As String, ByVal sz_EXEPath As String) As Integer Declare Function ReadRegDataFromINI Lib "GBLIB2.EXE" (ByVal sz_EXEPath As String, ByVal sz_Name As String, ByVal sz_Org As String, NameLen As Integer, OrgLen As Integer) As Integer ' //These Subs simply show information// Declare Sub ShowWinDir Lib "GBLIB2.EXE" () Declare Sub ShowSysDir Lib "GBLIB2.EXE" () ' //******************************************************************// ' //***** Data constants *****// Global Const MONTHSTRING = "JanFebMarAprMayJunJulAugSepOctNovDec" ' //############# ALTER THIS IF NEEDED ##############// Global Const EXPIRYDAYS = 31' //No. of days to expiry// ' //############# ALTER THIS IF NEEDED ##############// ' //******************************************************************// ' //***** Global Registration variables *****// Global sz_EXEPath As String' //The full path to a VB3 Executable// Global EXPIRED As Integer' //True/False. Set in GetDataFromEXE// ' //depends on constant EXPIRYDAYS// Global USERNAME As String' //33 characters maximum// Global USERORG As String' //33 characters maximum// Global BRANDDATE As String' //4 Characters// Global BRANDYEAR As Integer' //Range 95->// Global BRANDMONTH As Integer' //Range 1-12// Global BRANDDAY As Integer' //Range 1-31// ' //LONG Values depend on whether MSFINX.DLL is available// Global LONGBRANDDATE As Long' //Date registered/branded// Global LONGTODAYSDATE As Long' //System date// Global INI_USERNAME As String' //33 characters maximum// Global INI_USERORG As String' //33 characters maximum// ' //******************************************************************// Function Check_ErrorString (i_Errorcode As Integer) As String ' /* Modified 15/01/95 [GB] */ ' /* Created 15/01/95 [GB] */ Dim msg As String Select Case i_Errorcode Case 0 msg = "OK" Case 1 msg = "Name= entry does not match registration details" Case 2 msg = "Organisation= entry does not match registration details" Case 3 msg = "Both registration entries in the INI file have been altered" ' // Value > 8192 means that the EXE-file is unbranded/corrupt// Case 8303 msg = "Registration details in EXE file are absent. INI file is present." ' //Value > 16384 means that the INI-File is corrupt/absent// Case 16389 msg = "EXE is Unbranded. Name entry Name= is blank. Organisation= entry is correct." Case 16402 msg = "EXE is Unbranded. Name entry Name= is correct. Organisation= entry is blank." Case 16403 msg = "EXE is Unbranded. INI entry Name= is blank. Organisation= entry is incorrect." Case 16415 msg = "EXE is Unbranded. INI entry Organisation= is blank. Name= entry is incorrect." Case 16416 msg = "EXE is Unbranded. INI entry Name= is absent. Organisation= entry is incorrect." Case 16419 msg = "EXE is Unbranded. INI entry Name= is blank. Organisation= entry is blank." Case 16426 msg = "EXE is Unbranded. INI entry Name= is correct. Organisation= entry is missing." Case 16437 msg = "EXE is Unbranded. INI entry Name= is incorrect. Organisation= entry is missing." Case 16445 msg = "EXE is Unbranded. INI file is missing." Case 16454 msg = "This is a totally unregistered file." Case Else msg = "Unknown error. (Code #" & Format$(i_Errorcode) & ")" End Select Check_ErrorString = msg End Function Sub DevMsg () ' /* Modified 11/01/95 [GB] */ ' /* Modified 31/12/94 [GB] */ ' /* Created 31/12/94 [GB] */ ' //This message is shown if ISVBRUNNING returns true// Dim msg As String msg = "You are working in Development Mode" & Chr$(10) & Chr$(10) msg = msg & "I cannot therefore read or write data" & Chr$(10) msg = msg & "to or from this application," & Chr$(10) msg = msg & "because you havn't compiled it yet!" & Chr$(10) msg = msg & "Compile this application, and run it" & Chr$(10) msg = msg & "outside of the Visual Basic IDE entirely." MsgBox msg, 48, "REGMAX - Get / PutDataIntoEXE" End Sub Sub DisplayRegInfo () ' /* Modified 14/01/95 [GB] */ ' /* Modified 06/01/95 [GB] */ ' /* Created 06/01/95 [GB] */ Dim i_EXERetVal As Integer Dim i_INIRetVal As Integer i_EXERetVal = GetDataFromEXE()' //Sets USERNAME and USERORG// i_INIRetVal = GetDataFromINI()' //Sets INI_USERNAME and INI_USERORG// Dim msg As String msg = "" If (i_INIRetVal + i_EXERetVal) > 0 Then msg = msg & "This software is Unregistered." Else ' //Display embedded registration information// msg = msg & "This software is registered" & Chr$(10) msg = msg & "to: " & USERNAME & Chr$(10) msg = msg & "of: " & USERORG End If MsgBox msg, 64 + 4096, "Registration Information" End Sub Function DisplayRegInfoFromINI () As Integer ' /* Modified 14/01/95 [GB] */ ' /* Created 14/01/95 [GB] */ Dim i_RetVal As Integer i_RetVal = GetDataFromINI() DisplayRegInfoFromINI = i_RetVal Dim msg As String If i_RetVal > 0 Then msg = "This is an Unregistered INI." Else ' //Display embedded registration information// msg = "This software is registered" & Chr$(10) msg = msg & "to: " & INI_USERNAME & Chr$(10) msg = msg & "of: " & INI_USERORG End If MsgBox msg, 64 + 4096, "INI Registration Information" End Function Sub DisplayRegInfoWithExpiry () ' /* Modified 14/01/95 [GB] */ ' /* Modified 06/01/95 [GB] */ ' /* Created 06/01/95 [GB] */ Dim i_RetVal As Integer i_RetVal = GetDataFromEXE() Dim msg As String If i_RetVal > 0 Then msg = "This software is Unregistered." Else ' //Display embedded registration information// msg = "This software was registered" & Chr$(10) msg = msg & "to: " & USERNAME & Chr$(10) msg = msg & "of: " & USERORG ' //Optional line// msg = msg & Chr$(10) & "on: " & BRANDDATE ' //EXPIRED is set True/False by GetDataFromEXE// ' //EXPIRYDAYS is a Global Const set in (declarations) // If EXPIRED <> False Then msg = msg & Chr$(10) & Chr$(10) & "* YOUR " & Format$(EXPIRYDAYS) & "-DAY EVALUATION" & Chr$(10) msg = msg & "PERIOD HAS NOW EXPIRED." ' //Kill Application from the Hard Disk here// End If' //of If EXPIRED// End If' //of If UNLICENSED// MsgBox msg, 64 + 4096, "Registration Information" End Sub Function Get_sz_CurrentEXEPath () As String ' /* Modified 14/01/95 [GB] */ ' /* Created 14/01/95 [GB] */ Dim sz_TempPath As String ' //Get the full path and filename of this application// sz_TempPath = App.Path If Right$(sz_TempPath, 1) <> "\" Then sz_TempPath = sz_TempPath & "\" sz_TempPath = sz_TempPath & App.EXEName & ".EXE" Get_sz_CurrentEXEPath = sz_TempPath End Function Function GetDataFromEXE () As Integer On Error GoTo ERR_GDFE ' /* Modified 14/01/95 [GB] */ ' /* Modified 11/01/95 [GB] */ ' /* Modified 06/01/95 [GB] */ ' /* Modified 02/01/95 [GB] */ ' /* Modified 30/12/94 [GB] */ ' /* Created 30/12/94 [GB] */ ' //Quit out in development mode// If ISVBRUNNING() <> 0 Then DevMsg Exit Function End If Dim i_RetValue As Integer Dim NameLen As Integer Dim OrgLen As Integer Dim TUserName As String Dim TUserOrg As String Dim YMD As String ' //Initialise// EXPIRED = False BRANDDATE = "UNKNOWN" LONGBRANDDATE = 0 LONGTODAYSDATE = 0 '******** REM out next section if reading an external program ********** '*********************************************************************** ' //You MUST initialise the strings to this length or VB cannot// ' //cope with passing strings to/from the GBLIB2 API// TUserName = String$(42, 0) TUserOrg = String$(34, 0) YMD = String$(4, 0) ' //Read the Information from the EXE// i_RetValue = ReadRegData(sz_EXEPath, TUserName, TUserOrg, YMD, NameLen, OrgLen) ' //Return value is Zero if sz_EXEPath is branded OK, otherwise 1// ' //TUserName(NameLen+1) is ASCII(0) ' //TUserOrg(OrgLen+1) is ASCII(0) ' //If the EXE is 'virgin' then i_RetVal=1 ' and USERNAME and USERORG = 'UNLICENSED' // ' //Trim to the last useable character// USERNAME = Left$(TUserName, NameLen) USERORG = Left$(TUserOrg, OrgLen) GetDataFromEXE = i_RetValue ' //Now process the DATE information// ' //If the EXE is virgin then YMD is all spaces or ASCII 0// If Left$(YMD, 1) = " " Then Exit Function If Left$(YMD, 1) = Chr$(0) Then Exit Function ' //YMD = The Year-Month-Date in ASCII codes// ' //Here I unpack the YMD data into the 'English' form of dd mmmm yyyy// ' //1) Day// BRANDDAY = Asc(Mid$(YMD, 3, 1)) BRANDDATE = Format$(BRANDDAY, "#0") ' //2) Month// BRANDMONTH = Asc(Mid$(YMD, 2, 1)) BRANDDATE = BRANDDATE & " " & Mid$(MONTHSTRING, (BRANDMONTH) * 3 - 2, 3) ' //3) Year// ' //NOTE it is returned as (YY+108)// BRANDYEAR = Asc(Left$(YMD, 1)) - 108 BRANDDATE = BRANDDATE & " 19" & Format$(BRANDYEAR, "00") On Error GoTo NO_MSFINX_DLL ' //Make up numbers (that vary in days) for expiry comparisons// ' //Use financial functions if available// ' //Remember to include the financial DLLs on your distribution disk(s)// LONGBRANDDATE = DateSerial(BRANDYEAR, BRANDMONTH, BRANDDAY) LONGTODAYSDATE = DateSerial(Year(Now), Month(Now), Day(Now)) If Abs(LONGTODAYSDATE - LONGBRANDDATE) > EXPIRYDAYS Then EXPIRED = True ' //All OK// Exit Function ' //DateSerial function has caused an error, so come here// GDFE_OUT: ' //Resume here if VB3 Financial DLLs (e.g. MSFINX.DLL) are absent// LONGBRANDDATE = Val(Format$(BRANDYEAR, "00") & Format$(BRANDMONTH, "00") & Format$(BRANDDAY, "00")) LONGTODAYSDATE = Val(Format$(Now, "yymmdd")) ' //This will not work so well across month boundaries...// If Abs(LONGTODAYSDATE - LONGBRANDDATE) > EXPIRYDAYS Then EXPIRED = True ' //Resume here from a fatal error// GDFE_ERROR: Exit Function NO_MSFINX_DLL: ' //Triggered ErrorHandler// ' //Come here if VB3 Financial DLL is absent, and triggers an error// Resume GDFE_OUT ERR_GDFE: ' //Fatal ErrorHandler// MsgBox "Unable to fetch registration data", 48, "Sub GetDataFromEXE" Resume GDFE_ERROR End Function Function GetDataFromINI () As Integer ' /* Modified 14/01/95 [GB] */ ' /* Created 14/01/95 [GB] */ Dim TUserName As String Dim TUserOrg As String Dim i_RetValue As Integer Dim NameLen As Integer Dim OrgLen As Integer ' //You MUST initialise the strings to this length or VB cannot// ' //cope with passing strings to/from the GBLIB2 API// TUserName = String$(42, 0) TUserOrg = String$(34, 0) ' //Read the Information from the INI// i_RetValue = ReadRegDataFromINI(sz_EXEPath, TUserName, TUserOrg, NameLen, OrgLen) GetDataFromINI = i_RetValue ' //Return value is Zero if sz_EXEPath is branded OK, otherwise 1 or more// ' //i_RetVal=10 - Not a VB V3.0 program// ' //i_RetVal=11 - A VB V2.0 program// ' //i_RetVal=12 - A TPW program// ' //i_RetVal=13 - A 32-Bit program// ' //TUserName(NameLen+1) is ASCII(0) ' //TUserOrg(OrgLen+1) is ASCII(0) ' //If the INI is absent then i_RetVal=1 ' and USERNAME and USERORG = 'UNLICENSED' // ' //Trim to the last useable character// INI_USERNAME = Left$(TUserName, NameLen) INI_USERORG = Left$(TUserOrg, OrgLen) End Function Function IsUnRegistered () As Integer ' /* Modified 14/01/95 [GB] */ ' /* Created 14/01/95 [GB] */ Dim i_RetVal As Integer i_RetVal = GetDataFromEXE() i_RetVal = GetDataFromINI() i_RetVal = CheckRegistration(sz_EXEPath) IsUnRegistered = i_RetVal End Function Function ISVBRUNNING () As Integer ' /* Modified 06/01/95 [GB] */ ' /* Modified 31/12/94 [GB] */ ' /* Created 31/12/94 [GB] */ ' //Debugging line - Ignore// If LCase(Command$) = "debug" Then ISVBRUNNING = 0 Exit Function End If ' //Simple test to see if VB is in development mode// If FindIt("wndclass_desked_gsk", "Microsoft Visual Basic [run]") > 0 Then ISVBRUNNING = 1 Else ISVBRUNNING = 0 End If End Function Function PutDataIntoEXE (AName As String, AnOrganisation As String, sz_Key As String) As Integer ' /* Modified 14/01/95 [GB] */ ' /* Modified 06/01/95 [GB] */ ' /* Modified 31/12/94 [GB] */ ' /* Created 31/12/94 [GB] */ ' //OPTIONAL// ' //Quit if running in development mode// If ISVBRUNNING() <> 0 Then DevMsg Exit Function End If Dim i_RetValue As Integer ' //OPTIONAL// ' //NOTE: sz_EXEPath could be set to any VB3 program, not// ' //just this one. ' //Do the deed. Note that AName and AnOrganisation will be truncated// ' //if either are over 33 characters// i_RetValue = WriteRegData(AName, AnOrganisation, sz_EXEPath, sz_Key) PutDataIntoEXE = i_RetValue ' //Return value is zero for success/ ' //Return value is 1 if either item has been truncated// ' //Return value is 2 if USERNAME was an empty string// ' //Return value is 3 if USERORG was an empty string// ' //Return value is 99 if sz_Key was bad// End Function Function PutDataIntoINI (AName As String, AnOrganisation As String) As Integer ' /* Modified 14/01/95 [GB] */ ' /* Created 14/01/95 [GB] */ ' //OPTIONAL// ' //Quit if running in development mode// If ISVBRUNNING() <> 0 Then DevMsg Exit Function End If Dim i_RetValue As Integer ' //NOTE: sz_EXEPath could be set to any VB3 program, not// ' //just this one. ' //Do the deed. Note that AName and AnOrganisation will be truncated// ' //if either are over 33 characters// ' //Write to/Create and write to (APP.EXEName).INI file in WINDOWS directory// i_RetValue = WriteRegDataToINI(AName, AnOrganisation, sz_EXEPath) ' //Return value is zero for success/ ' //Return value is 1 if USERNAME was an empty string// ' //Return value is 2 if USERORG was an empty string// ' //Return value is 3 if unable to write User= entry in the INIFile// ' //Return value is 4 if unable to write Organisation= entry in the INIFile// ' //Return value is 99 if sz_Key was bad// PutDataIntoINI = i_RetValue End Function Sub ShowSplash () ' /* Modified 14/01/95 [GB] */ ' /* Modified 06/01/95 [GB] */ ' /* Created 06/01/95 [GB] */ Dim i_RetVal As Integer i_RetVal = GetDataFromEXE() ' //Is it a 'virgin' EXE? // If USERNAME = "UNLICENSED" Then MsgBox "This is an unlicensed copy of " & App.EXEName, 64 + 4096, App.EXEName & " Registration Information" Else ' //Display embedded registration information// DisplayRegInfo End If End Sub 
